home *** CD-ROM | disk | FTP | other *** search
- /* Kevo -- a prototype-based object-oriented language */
- /* (c) Antero Taivalsaari 1991-1993 */
- /* Some parts (c) Antero Taivalsaari 1986-1988 */
- /* family.c: Clone family management internals */
-
- #include "global.h"
- #include "portGlobal.h"
-
- /*--------------------------------------------------------------------------*/
- /* Context management operations */
-
- /* cloneObject(): shallow copy an existing OOP object */
- /* The new object is added to the clone family */
- /*
- Note that no checks are made whether the given object really
- is a valid OOP object with its own context, so be careful.
- */
- OBJECT* cloneObject(oldObject)
- OBJECT* oldObject;
- {
- /* copyObject is defined in 'memory.c' */
- OBJECT* newObject = copyObject(oldObject);
- CONTEXT* context = getContext(oldObject);
-
- /* Add the copy to the clone family */
- addToList(context->cloneFamily, newObject);
-
- return(newObject);
- }
-
-
- /* deriveObject(): starts the addition of new properties to an existing object */
- /*
- This operation allows objects to be derived from existing objects so that
- they both can be modified on individual basis regardless of the fact that
- sharing is used at the implementation level.
-
- If the number of objects in the current clone family exceeds one, a new
- clone family (child to the original one) will be created automatically,
- thus guaranteeing the individual modifiability of objects, without losing
- the derivation relationship between them.
-
- This operation should be invoked between cloning and subsequent modification.
-
- Note that this operation may change the context of an object, so you should
- not use any old references to the context after executing this operation.
- All such references must be updated using 'getContext(object)'.
- */
- void deriveObject(object)
- OBJECT* object;
- {
- CONTEXT* oldContext = getContext(object);
- CONTEXT* newContext;
- LIST* cloneFamily = oldContext->cloneFamily;
-
- /* If no other copies of this object exist -> no need to create new family */
- if (cloneFamily->logicalSize <= 1) return;
-
- /* Otherwise, build a child family:
- first, duplicate the existing context (name space).
- */
- newContext = copyContext(oldContext);
-
- /* The family lists of the new context are initially empty */
- newContext->cloneFamily = createList();
- newContext->parentFamilies = createList();
- newContext->childFamilies = createList();
-
- /* Add the old context to the parent list of the new context */
- addToList(newContext->parentFamilies, oldContext->cloneFamily);
-
- /* Add the new context to the child list of the old context */
- addToList(oldContext->childFamilies, newContext->cloneFamily);
-
- /* Add the object to the new clone family */
- addToList(newContext->cloneFamily, object);
-
- /* Remove the object from its old clone family */
- /* Note that when executing this operation, the old context */
- /* will not be deleted (as copy count is guaranteedly >= 2) */
- removeFromItsFamily(object);
-
- /* Finally, replace the object's parameter field (the context) with the new context */
- object->mfa->pfa = (int*)newContext;
- }
-
-
- /* makeParent(): make a certain object (family) a parent of another object (family) */
- /* If the parent is previously a child of the object, then remove it from the child */
- /* (only the latest 'makeParent' prevails) */
-
- void makeParent(thisObject, parentObject)
- OBJECT* thisObject;
- OBJECT* parentObject;
- {
- CONTEXT* thisContext = getContext(thisObject);
- CONTEXT* parentContext = getContext(parentObject);
-
- /* If the object and suggested parent belong to the same family */
- /* don't do anything */
- if (thisContext == parentContext) return;
-
- /* If the parent is previously a child of the object, */
- /* remove it from the child list */
- removeFromList(thisContext->childFamilies, parentContext->cloneFamily);
- removeFromList(parentContext->parentFamilies, thisContext->cloneFamily);
-
- /* Add the clone family of this object to the child family list */
- /* of the parent object */
- condAddToList(parentContext->childFamilies, thisContext->cloneFamily);
-
- /* Add the clone family of the parent object to the parent family */
- /* list of this object */
- condAddToList(thisContext->parentFamilies, parentContext->cloneFamily);
- }
-
-
- /*
- removeFromItsFamily(): remove the given object from its clone family,
- possibly deleting the clone family and reorganizing the family hierarchy.
- This operation is used internally when an object is moved to another
- clone family. Be careful when using it, because after it has been executed,
- the given object is hanging loose outside of any clone family.
- */
- void removeFromItsFamily(object)
- OBJECT* object;
- {
- CONTEXT* context = getContext(object);
- LIST* cloneFamily = context->cloneFamily;
-
- if (!removeFromList(cloneFamily, object)) {
- fprintf(confile, "== Integrity error detected: object not found in its clone family ==\n");
- reportIntegrityError();
- ownLongJmp();
- }
- else {
- /* If the family is now empty, rearrange the family hierarchy */
- if (cloneFamily->logicalSize == 0) {
- LIST* parf = context->parentFamilies;
- LIST* chif = context->childFamilies;
- WindowPtr familyBrowser;
- int index1;
- int index2;
-
- /* Go through the parent family list */
- for (index1 = 1; index1 <= parf->logicalSize; index1++) {
- OBJECT* firstObj = (OBJECT*)fetchFromList((LIST*)fetchFromList(parf, index1), 1);
- CONTEXT* firstCtxt = getContext(firstObj);
- LIST* thisList = firstCtxt->childFamilies;
-
- if (thisList) {
- /* Remove the clone family from the child family lists of each parent */
- removeFromList(thisList, cloneFamily);
-
- /* Add each child family to the child family list of every parent */
- for (index2 = 1; index2 <= chif->logicalSize; index2++)
- addToList(thisList, fetchFromList(chif, index2));
- }
- }
-
- /* Go through the child family list */
- for (index1 = 1; index1 <= chif->logicalSize; index1++) {
- OBJECT* firstObj = (OBJECT*)fetchFromList((LIST*)fetchFromList(chif, index1), 1);
- CONTEXT* firstCtxt = getContext(firstObj);
- LIST* thisList = firstCtxt->parentFamilies;
-
- if (thisList) {
- /* Remove the clone family from the parent family lists of each child */
- removeFromList(thisList, cloneFamily);
-
- /* Add each parent family to the parent family list of every child */
- for (index2 = 1; index2 <= parf->logicalSize; index2++)
- addToList(thisList, fetchFromList(parf, index2));
- }
- }
-
- /* If there exists a browser for the clone family, delete it */
- /* yyy warning: this piece of code is non-portable */
- familyBrowser = findBrowser(cloneFamily);
- if (familyBrowser) deleteBrowser(familyBrowser);
-
- /* Finally, delete the old context and its (now empty) family lists */
- deleteList(context->cloneFamily);
- deleteList(context->parentFamilies);
- deleteList(context->childFamilies);
- deleteContext(context);
- }
- }
- }
-
-
- /* moveToContext(): move the given object to another context/clone family
-
- Note that this operation can change the context of an object, so you should
- not use any old references to the context after executing this operation.
- All such references must be updated using 'getContext(object)'.
- */
- void moveToContext(object, newContext)
- OBJECT* object;
- CONTEXT* newContext;
- {
- /* Just in case the new context happens to be the same as old */
- if (getContext(object) == newContext) return;
-
- /* Remove the object from its old clone family, deleting the */
- /* old family and possibly rearranging the family hierarchy */
- removeFromItsFamily(object);
-
- /* Add the object to the new clone family */
- addToList(newContext->cloneFamily, object);
-
- /* Finally, replace the object's parameter field (the context) with the new context */
- object->mfa->pfa = (int*)newContext;
- }
-
-
- /* possiblyMoveObject(): given an object, check if there is an
- object in the given family list whose interface and operations are
- exactly the same as the given object has. If there is, move the object
- to the family of that object (removing the old family if needed).
-
- This operation is used for moving objects to their immediate parent
- and child families when their interface changes.
- */
- int possiblyMoveObject(object, familyList)
- OBJECT* object;
- LIST* familyList; /* List of families */
- {
- CONTEXT* context = getContext(object);
- int index;
-
- if (!familyList) return(FALSE);
-
- /* Go through all the families, looking for one with a matching interface */
- for (index = 1; index <= familyList->logicalSize; index++) {
- /* Get the first object in the family */
- OBJECT* firstObj = (OBJECT*)fetchFromList((LIST*)fetchFromList(familyList, index), 1);
- CONTEXT* newContext = getContext(firstObj);
-
- /* If the parent context is similar -> move */
- if (compareContexts(context, newContext)) {
- moveToContext(object, newContext);
- return(TRUE);
- }
- }
- return(FALSE);
- }
-
-
- /* possiblyMoveFamily()
- This is the same as above, but it will (possibly) move
- all the objects in the same clone family. As a result,
- the old clone family/context will be deleted.
- */
- int possiblyMoveFamily(object, familyList)
- OBJECT* object;
- LIST* familyList;
- {
- CONTEXT* context = getContext(object);
- LIST* cloneFamily = context->cloneFamily;
- int count;
-
- count = cloneFamily->logicalSize;
-
- /* Try to move all the objects in the clone family */
- /* Note: possiblyMoveObject slides the family list, so the index is always 1 */
- while (count--) {
- OBJECT* thisObject = (OBJECT*)fetchFromList(cloneFamily, 1);
- if (!possiblyMoveObject(thisObject, familyList)) return(FALSE);
- }
-
- return(TRUE);
- }
-
-
- /* Move the individual object or the whole clone family upwards or downwards
- in the clone family hierarchy if a suitable immediate parent or child
- family can be found. "Suitability" is based on the equivalence of
- objects' interfaces and operations.
-
- This operation should be invoked always after an object has undergone
- a major structural change.
- */
- void confirmObjectType(object, whoToModify, kindOfModification)
- OBJECT* object;
- int whoToModify;
- int kindOfModification;
- {
- CONTEXT* context = getContext(object);
- LIST* parf = context->parentFamilies;
- LIST* chif = context->childFamilies;
-
- switch (kindOfModification) {
-
- case REDEFINING_SOMETHING:
- /* In the current version we cannot do behavioral comparisons,
- so the object or family cannot be merged with any other family
- after modifications. Sorry.
- */
- return;
-
- case REMOVING_SOMETHING:
- /* If the context is empty (has no properties) after the */
- /* modifications, remove all the parents and children. */
- if (context->firstPair == NIL) {
- removeAllRelatives(object);
- return; /* This is intentionally 'return' (no need to continue) */
- }
- }
-
- /* In other modes, the modification may result in the object
- or family being similar to one of its parents or children
- (we cannot be sure about the direction). Therefore, we try
- to rearrange the family hierarchy by trying to merge the
- object or the whole family with one of its immediate parent
- or child families
- */
- switch (whoToModify) {
- case THIS_ONLY:
- if (possiblyMoveObject(object, parf)) break;
- if (possiblyMoveObject(object, chif)) break;
- break;
-
- case WHOLE_FAMILY:
- if (possiblyMoveFamily(object, parf)) break;
- if (possiblyMoveFamily(object, chif)) break;
- break;
-
- case DERIVATIVES:
- /* When larger groups of objects are modified,
- the hierarchy remains the same.
- */
- break;
-
- }
- /* Finally: ensure that after the modifications the object still
- has at least something in common with each of its parents.
- If it doesn't, remove parent link, but try to link the object
- or family to some of the removed parent's parents.
- */
- ensureParentCompatibility(object);
- }
-
-
- /* ensureParentCompatibility(): ensure that the object has at least
- something in common with each of its parents. If it doesn't,
- remove parent link, but try to link the object's family to
- some of the removed parent's parents.
- */
- void ensureParentCompatibility(thisObject)
- OBJECT* thisObject;
- {
- CONTEXT* thisContext = getContext(thisObject);
- LIST* thisFamily = thisContext->cloneFamily;
- LIST* parf = thisContext->parentFamilies;
- int index1;
-
- /* Walk through each of the parents */
- for (index1 = 1; index1 <= parf->logicalSize; index1++) {
- /* (we utilize the fact that each clone family has at least one member) */
- OBJECT* parentObject = (OBJECT*)fetchFromList((LIST*)fetchFromList(parf, index1), 1);
- CONTEXT* parentContext = getContext(parentObject);
-
- /* Check that there is at least something in common with the
- object and the parent (i.e., at least one of the properties
- must be precisely the same).
- */
- if (!compareContextResemblance(thisContext, parentContext)) {
-
- /* If there isn't any resemblance, remove the parent link */
- removeFromList(thisContext->parentFamilies, parentContext->cloneFamily);
- removeFromList(parentContext->childFamilies, thisContext->cloneFamily);
-
- /* But, try to find some of the removed parent' parents which might match */
-
- /* If found, make this a parent of our object */
- }
- }
- }
-
-
- /* removeAllRelatives(): If all the properties are removed from an object
- there is not point for that object/clone family to have parents or
- children any more. This operation is used to remove the parents and
- children from a given object in such a situation.
- */
- void removeAllRelatives(object)
- OBJECT* object;
- {
- CONTEXT* context = getContext(object);
- LIST* cloneFamily = context->cloneFamily;
- LIST* parf = context->parentFamilies;
- LIST* chif = context->childFamilies;
- int index1;
-
- /* First, we remove the clone family from the child family lists of its parents */
- for (index1 = 1; index1 <= parf->logicalSize; index1++) {
- /* (we utilize the fact that each clone family has at least one member) */
- OBJECT* firstObj = (OBJECT*)fetchFromList((LIST*)fetchFromList(parf, index1), 1);
- CONTEXT* firstCtxt = getContext(firstObj);
- LIST* thisList = firstCtxt->childFamilies;
-
- if (thisList) removeFromList(thisList, cloneFamily);
- }
-
- /* Then, we remove the object from the parent family lists of its children */
- for (index1 = 1; index1 <= chif->logicalSize; index1++) {
- OBJECT* firstObj = (OBJECT*)fetchFromList((LIST*)fetchFromList(chif, index1), 1);
- CONTEXT* firstCtxt = getContext(firstObj);
- LIST* thisList = firstCtxt->parentFamilies;
-
- if (thisList) removeFromList(thisList, cloneFamily);
- }
-
- /* Finally, we can now empty the parent and child families of the object */
- emptyList(parf);
- emptyList(chif);
- }
-
-
- /* resizeFamilyMembers(): given an object, resize all the objects in its clone family */
- /* This operation is needed when VARs are added to an object */
-
- void resizeFamilyMembers(object, newSize)
- OBJECT* object;
- int newSize;
- {
- CONTEXT* context = getContext(object);
- LIST* cloneFamily = context->cloneFamily;
- int familySize = cloneFamily->logicalSize;
-
- if (familySize > 0) {
- int index;
-
- /* Resize each member of the clone family */
- for (index = 1; index <= familySize; index++) {
- OBJECT* member = (OBJECT*)fetchFromList(cloneFamily, index);
- resizeClosure(member, newSize);
- }
- }
- /*
- In the current implementation, it is possible that some objects
- have an empty clone family. For such objects, do the plain resize.
- */
- else resizeClosure(object, newSize);
- }
-
-
- /* CheckFamilyIntegrity(): check the integrity of a clone family
- by ensuring that the current clone family is found in the child family
- lists of its parents, and in the parent family lists of its children.
- Return TRUE if the family is ok, FALSE otherwise.
-
- This operation is used solely for ensuring that the other family
- operations work correctly.
- */
- int checkFamilyIntegrity(context)
- CONTEXT* context;
- {
- LIST* cf = context->cloneFamily;
- LIST* parf = context->parentFamilies;
- LIST* chif = context->childFamilies;
- int index;
-
- /* Go through the parent family list */
- for (index = 1; index <= parf->logicalSize; index++) {
- OBJECT* firstObj = (OBJECT*)fetchFromList((LIST*)fetchFromList(parf, index), 1);
- CONTEXT* firstCtxt = getContext(firstObj);
- LIST* thisList = firstCtxt->childFamilies;
-
- if (!findInList(thisList, cf)) {
- fprintf(confile, "== Integrity error detected: family not found in the child list of its parent ==\n");
- return(FALSE);
- }
- }
-
- /* Go through the child family list */
- for (index = 1; index <= chif->logicalSize; index++) {
- OBJECT* firstObj = (OBJECT*)fetchFromList((LIST*)fetchFromList(chif, index), 1);
- CONTEXT* firstCtxt = getContext(firstObj);
- LIST* thisList = firstCtxt->childFamilies;
-
- if (!findInList(thisList, cf)) {
- fprintf(confile, "== Integrity error detected: family not found in the parent list of its child ==\n");
- return(FALSE);
- }
- }
-
- return(TRUE);
- }
-
-
-